با توجه به سوالات مرگ و میر در آمریکا به سوالات زیر پاسخ دهید.

۱. از میان متغیرهای داده مرگ و میر یک زیرمجموعه ایی بدون حشو در نظر بگیرید. ماتریس همبستگی متغیرهای مختلف را به دست آورده و سپس رسم نمایید. علاوه بر این نمودار پراکنش متغیرهای انتخاب شده را همزمان نسبت به هم رسم نمایید. 

rbind(ms %>% 
  filter(EducationReportingFlag == 1, AgeType == 1) %>% 
  select(Id, ResidentStatus, Education2003Revision, MonthOfDeath, Age, Sex,
         PlaceOfDeathAndDecedentsStatus, DayOfWeekOfDeath, MannerOfDeath,
         ActivityCode, PlaceOfInjury, Cause = CauseRecode39,Race =  RaceRecode5, MaritalStatus, InjuryAtWork,
         MethodOfDisposition, Autopsy,
         NumberOfEntityAxisConditions, NumberOfRecordAxisConditions),
  ms %>% filter(EducationReportingFlag == 1, AgeType != 9, AgeType != 1) %>%
    mutate(Age = (AgeType == 2) * 1 /12 + (AgeType == 3) * 1 /365) %>% 
    select(Id, ResidentStatus, Education2003Revision, MonthOfDeath, Age, Sex,
           PlaceOfDeathAndDecedentsStatus, DayOfWeekOfDeath, MannerOfDeath,
           ActivityCode, PlaceOfInjury,Cause = CauseRecode39,Race =  RaceRecode5, MaritalStatus, InjuryAtWork,
           MethodOfDisposition, Autopsy,
           NumberOfEntityAxisConditions, NumberOfRecordAxisConditions))-> ms_1

# ms_1$Education2003Revision[ms_1$Education2003Revision == 9] <- NA
# ms_1$AgeRecode52[ms_1$AgeRecode52 == 52] <- NA
# ms_1$MaritalStatus[ms_1$MaritalStatus == 'U'] <- NA
# ms_1$MannerOfDeath[ms_1$MannerOfDeath == 0] <- NA
# ms_1$MethodOfDisposition[ms_1$MethodOfDisposition == 'U'] <- NA
# ms_1$Autopsy[ms_1$Autopsy == 'U'] <- NA
# 
# ms_reduced <- ms_1 %>% filter(!is.na(Education2003Revision), is.na(AgeRecode52),
#                               is.na(MaritalStatus), is.na(MannerOfDeath),
#                               is.na(MethodOfDisposition), is.na(Autopsy))
# 
ms_reduced <- ms_1
ms_reduced$MaritalStatus <- as.factor(ms_reduced$MaritalStatus)
ms_reduced$InjuryAtWork <- as.factor(ms_reduced$InjuryAtWork)
ms_reduced$MethodOfDisposition <- as.factor(ms_reduced$MethodOfDisposition)
ms_reduced$Autopsy <- as.factor(ms_reduced$Autopsy)
ms_reduced$Race <- as.factor(ms_reduced$Race)
ms_reduced$Cause <- as.factor(ms_reduced$Cause)



ms_reduced[] <- lapply(ms_reduced, function(x) {
  if(is.factor(x)) as.numeric(x) else x
})
#sapply(ms_reduced, class)

ms_reduced_2 <- (ms_reduced %>% select(-Id))

cormat <- round(cor(ms_reduced_2), 4)

melted_cormat <- melt(cormat, na.rm = TRUE)

ggplot(data = melted_cormat, aes(x = Var1, y = Var2, fill = value)) +
  geom_tile(color = "white") +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white", 
                       midpoint = 0, limit = c(-1,1), space = "Lab",name="Pearson\nCorrelation")+
  theme(axis.text.x = element_text(angle = 45, vjust = 1, 
                                   size = 8, hjust = 1),
        axis.text.y = element_text(angle = 0, vjust = 1, 
                                   size = 8, hjust = 1))+
  coord_fixed()

ms_reduced_3 <- (ms_reduced %>% select(-Id))[sample(1:nrow(ms_reduced), 1000),]
library(GGally)
ggpairs(ms_reduced_3)

۲. اثر هر یک از متغیرهای جنسیت، نژاد،آموزش، سن و نحوه تدفین را بر مرگ یا خودکشی ارزیابی کنید.

از آنجایی که همه ی متغیرهای گفته شده فکتور هستند به جز سن، برای همه ی آن ها به جز سن از تست chi-squared استفاده می کنیم. همچنین برای سن از محاسبه ی رگرسیون لاجستیک و بررسی موثر بودن سن در آن استفاده می کنیم. نتیجه می شود که تمامی این عوامل موثرند. 

library(cramer)

ms_2 <- ms %>%
  filter(EducationReportingFlag == 1) %>% 
  select(MannerOfDeath, Sex, Education2003Revision,
         Race, Age, MethodOfDisposition)  %>%
  mutate(MannerOfDeath = as.factor((MannerOfDeath == 2)* 1))

ms_2$Education2003Revision <- as.factor(ms_2$Education2003Revision)
ms_2$Sex <- as.factor(ms_2$Sex)
ms_2$MethodOfDisposition <- as.factor(ms_2$MethodOfDisposition)
ms_2$Race <- as.factor(ms_2$Race)

chisq.test(ms_2$MannerOfDeath, ms_2$Sex)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  ms_2$MannerOfDeath and ms_2$Sex
## X-squared = 25.178, df = 1, p-value = 5.228e-07
chisq.test(ms_2$MannerOfDeath, ms_2$Education2003Revision)
## 
##  Pearson's Chi-squared test
## 
## data:  ms_2$MannerOfDeath and ms_2$Education2003Revision
## X-squared = 3552.8, df = 8, p-value < 2.2e-16
chisq.test(ms_2$MannerOfDeath, ms_2$Race)
## 
##  Pearson's Chi-squared test
## 
## data:  ms_2$MannerOfDeath and ms_2$Race
## X-squared = 13768, df = 13, p-value < 2.2e-16
summary(glm(MannerOfDeath ~ Age,  data = ms_2, family = binomial))
## 
## Call:
## glm(formula = MannerOfDeath ~ Age, family = binomial, data = ms_2)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -8.4904  -1.2225   0.6249   0.8410   1.2943  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -0.6089375  0.0248738  -24.48   <2e-16 ***
## Age          0.0375982  0.0005942   63.28   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 64732  on 54378  degrees of freedom
## Residual deviance: 60067  on 54377  degrees of freedom
## AIC: 60071
## 
## Number of Fisher Scoring iterations: 5
chisq.test(ms_2$MannerOfDeath, ms_2$MethodOfDisposition)
## 
##  Pearson's Chi-squared test
## 
## data:  ms_2$MannerOfDeath and ms_2$MethodOfDisposition
## X-squared = 4438.3, df = 6, p-value < 2.2e-16

۳. با استفاده از مدل رگرسیون لاجستیک یک مدل به داده ها برازش دهید و سپس آن را نقص یابی کنید. 

ms_1 %>%
  mutate(MannerOfDeath = as.factor((MannerOfDeath == 2)* 1)) -> ms_3
ms_3$MethodOfDisposition[ms_3$MethodOfDisposition == 'U'] <- NA
ms_3$MaritalStatus[ms_3$MaritalStatus == 'U'] <- NA
ms_3$InjuryAtWork[ms_3$InjuryAtWork == 'U'] <- NA
ms_3$Autopsy[ms_3$Autopsy == 'U'] <- NA
ms_3$PlaceOfInjury[ms_3$PlaceOfInjury == 9 ] <- NA
ms_3$ActivityCode[ms_3$ActivityCode == 99 ] <- NA
as.factor(ms_3$Race) -> ms_3$Race 
as.factor(ms_3$ResidentStatus) -> ms_3$ResidentStatus
as.factor(ms_3$Education2003Revision) -> ms_3$Education2003Revision
as.factor(ms_3$PlaceOfDeathAndDecedentsStatus) -> ms_3$PlaceOfDeathAndDecedentsStatus
as.factor(ms_3$Cause) -> ms_3$Cause
as.factor(ms_3$PlaceOfInjury) -> ms_3$PlaceOfInjury
as.factor(ms_3$ActivityCode) -> ms_3$ActivityCode
as.factor(ms_3$DayOfWeekOfDeath) -> ms_3$DayOfWeekOfDeath
as.factor(ms_3$MonthOfDeath) -> ms_3$MonthOfDeath
as.factor(ms_3$Sex) -> ms_3$Sex
as.factor(ms_3$InjuryAtWork) -> ms_3$InjuryAtWork
as.factor(ms_3$MaritalStatus) -> ms_3$MaritalStatus
as.factor(ms_3$Autopsy) -> ms_3$Autopsy
na.omit(ms_3) -> ms_3


#model <- glm(MannerOfDeath ~.-Id, data = ms_3, family = binomial)
#summary(model)

model <- glm(
  MannerOfDeath ~.-Id-Cause-ActivityCode-MonthOfDeath-MethodOfDisposition-PlaceOfInjury,
  data = ms_3,
  family = binomial)
summary(model)
## 
## Call:
## glm(formula = MannerOfDeath ~ . - Id - Cause - ActivityCode - 
##     MonthOfDeath - MethodOfDisposition - PlaceOfInjury, family = binomial, 
##     data = ms_3)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.7897  -0.3226   0.1289   0.5193   2.8664  
## 
## Coefficients:
##                                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                      1.720829   0.131557  13.081  < 2e-16 ***
## ResidentStatus2                  0.209478   0.045583   4.595 4.32e-06 ***
## ResidentStatus3                  0.346494   0.062690   5.527 3.26e-08 ***
## ResidentStatus4                 -0.547204   0.237973  -2.299 0.021480 *  
## Education2003Revision2           0.581400   0.064169   9.060  < 2e-16 ***
## Education2003Revision3           0.923188   0.059416  15.538  < 2e-16 ***
## Education2003Revision4           1.346649   0.066431  20.272  < 2e-16 ***
## Education2003Revision5           1.340796   0.082347  16.282  < 2e-16 ***
## Education2003Revision6           1.791921   0.079737  22.473  < 2e-16 ***
## Education2003Revision7           1.810466   0.116379  15.557  < 2e-16 ***
## Education2003Revision8           1.905289   0.173490  10.982  < 2e-16 ***
## Education2003Revision9           0.797102   0.123110   6.475 9.50e-11 ***
## Age                              0.016973   0.001081  15.708  < 2e-16 ***
## SexM                             0.383039   0.034976  10.952  < 2e-16 ***
## PlaceOfDeathAndDecedentsStatus2 -0.251335   0.057960  -4.336 1.45e-05 ***
## PlaceOfDeathAndDecedentsStatus3  0.185665   0.116379   1.595 0.110634    
## PlaceOfDeathAndDecedentsStatus4  1.308426   0.053141  24.622  < 2e-16 ***
## PlaceOfDeathAndDecedentsStatus5 -1.009601   0.269732  -3.743 0.000182 ***
## PlaceOfDeathAndDecedentsStatus6 -0.956681   0.258810  -3.696 0.000219 ***
## PlaceOfDeathAndDecedentsStatus7  0.437861   0.051325   8.531  < 2e-16 ***
## PlaceOfDeathAndDecedentsStatus9  0.406278   0.360739   1.126 0.260065    
## DayOfWeekOfDeath2                0.242817   0.052551   4.621 3.83e-06 ***
## DayOfWeekOfDeath3                0.292755   0.053339   5.489 4.05e-08 ***
## DayOfWeekOfDeath4                0.184836   0.052781   3.502 0.000462 ***
## DayOfWeekOfDeath5                0.227078   0.053680   4.230 2.33e-05 ***
## DayOfWeekOfDeath6                0.183272   0.053655   3.416 0.000636 ***
## DayOfWeekOfDeath7               -0.007008   0.052590  -0.133 0.893995    
## DayOfWeekOfDeath9                0.983229   0.687132   1.431 0.152454    
## Race2                           -2.045675   0.037597 -54.411  < 2e-16 ***
## Race3                           -0.947840   0.109847  -8.629  < 2e-16 ***
## Race4                           -0.257587   0.086598  -2.975 0.002935 ** 
## MaritalStatusM                   0.150054   0.045013   3.334 0.000857 ***
## MaritalStatusS                  -0.162889   0.046095  -3.534 0.000410 ***
## MaritalStatusW                  -0.258611   0.075937  -3.406 0.000660 ***
## InjuryAtWorkY                   -1.445721   0.121939 -11.856  < 2e-16 ***
## AutopsyY                        -3.599705   0.081569 -44.131  < 2e-16 ***
## NumberOfEntityAxisConditions     1.077311   0.028543  37.744  < 2e-16 ***
## NumberOfRecordAxisConditions    -1.174563   0.028429 -41.316  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 55358  on 47660  degrees of freedom
## Residual deviance: 30114  on 47623  degrees of freedom
## AIC: 30190
## 
## Number of Fisher Scoring iterations: 7
par(mar=c(1,1,1,1))
library(boot)
glm.diag.plots(model, glmdiag = glm.diag(model))

library(ResourceSelection)
hoslem.test(ms_3$MannerOfDeath, fitted(model))
## 
##  Hosmer and Lemeshow goodness of fit (GOF) test
## 
## data:  ms_3$MannerOfDeath, fitted(model)
## X-squared = 47661, df = 8, p-value < 2.2e-16

برای نقص یابی از ۴ نمودار استفاده می کنیم. نمودار بالا سمت راست نمودار normal-QQ است که یاید روی یک خط باشد که هست. البته از آنجایی که مدلمان لاجیستیک است خیلی نمی توان از این برداشتی کرد. نمودار بالا سمت چپ نمودار jackknife-deviance-residuals و fitted-values است که باید فاقد پترنی مشخص باشد که اینگونه نیست. یعنی مدل ما مشکلات نرمال بود و احتمالن همگن بودن دارد. البته از آنجایی که مدلمان لاجیستیک است خیلی نمی توان از این برداشتی کرد. نمودار سمت چپ پایین نمودار Cook-statistics و leverage که باید نقاطش در ناحیه ی مشخص شده باشد. در این نمودار نقاط هر چقدر بالاتر باشند تاثیر بیشتری در مدل دارند. نقاط سمت راست خط هم leverage بیشتری در مقایسه با variance باقیمانده ی خام در آن نقطه دارند. نمودار سمت راست پایین نمودار Cook-statistic است که باید نقاطش در ناحیه ی مشخص شده باشد. این نمودار نشان می دهد که مشاهدات چقدر موثر هستند. از این نمودار می توان برای تشخیص outlier ها استفاده کرد.

همچنین hoslem-test که برای بررسی خوب بودن فیت شدن مدل استفاده می شود به ما نشان می دهد که مدلمان خوب نیست.

پس در مجموع مدل فیت شده شرایط رگرسیون را ندارد.

۴. با استفاده از سه نمودار خروجی مدل را نسبت به داده واقعی ارزیابی کنید.

انواع خطاها را به همراه داده ها ترسیم می کنیم. 

ms_4 = ms_3 %>% mutate(pred = fitted(model))

ggplot(ms_4,aes(x = Age,y = pred,col = MannerOfDeath))+
  geom_point(alpha = 0.5)

ggplot() + 
  geom_line(aes(x = model$linear.predictors, y = model$fitted.values), color = "red", alpha = 0.8) + 
  geom_point(aes(color = ms_4$MannerOfDeath, x = model$linear.predictors, y = as.numeric(as.character(ms_4$MannerOfDeath))))+
  xlab("Age")+
  ylab("MannerOfDeath")

ggplot(ms_4, aes(pred, color = MannerOfDeath )) + 
  geom_density( size = 1 ) +
  ggtitle( "Training Set's Predicted Score")

cm_info = ConfusionMatrixInfo(data = ms_4, predict = "pred", 
                               actual = "MannerOfDeath", cutoff = .5 )
cm_info$plot

۵. ابتدا ۲۰ درصد داده را به صورت تصادفی به عنوان تست در نظر بگیرید. مدل را با استفاده از ۸۰ درصد باقی مانده برازش دهید. با استفاده از پارامتر قطع ۰.۵ نتایج را برای داده تست پیش بینی کنید. سپس کمیت های زیر را محاسبه کنید.

مشابه آنچه در کلاس گفته شد نمایشی از چهار کمیت TN, TP,FP,FN به همراه داده ها رسم نمایید. 

set.seed(200)
index = sample(x= 1:nrow(ms_3),size = 0.8*nrow(ms_3),replace = F)
train = ms_3[index,] 
test =  ms_3[-index,]
model_glm = glm(
  MannerOfDeath ~.-Id-Cause-ActivityCode-MonthOfDeath-MethodOfDisposition-PlaceOfInjury,
  data = train,
  family = "binomial")
# prediction
train$prediction = predict( model_glm, newdata = train, type = "response" )
test$prediction  = predict( model_glm, newdata = test , type = "response" )

co <- 0.5
cm_info = ConfusionMatrixInfo( data = test, predict = "prediction", 
                               actual = "MannerOfDeath", cutoff = co)
cm_info$plot

P <- test %>% filter(prediction > co) %>% count()
N <- test %>% filter(prediction <= co) %>% count()
TP <- test %>% filter(prediction > co, MannerOfDeath == 1) %>% count()
TN <- test %>% filter(prediction <= co, MannerOfDeath == 0) %>% count()
FP <- test %>% filter(prediction > co, MannerOfDeath == 0) %>% count()
FN <- test %>% filter(prediction <= co, MannerOfDeath == 1) %>% count()

sprintf("positive samples: %.0f", P)
## [1] "positive samples: 7258"
sprintf("negative samples: %.0f", N)
## [1] "negative samples: 2275"
sprintf("true positive: %.0f", TP)
## [1] "true positive: 6415"
sprintf("true negative: %.0f", TN)
## [1] "true negative: 1775"
sprintf("false positive: %.0f", FP)
## [1] "false positive: 843"
sprintf("false negative: %.0f", FN)
## [1] "false negative: 500"
ACC <- (TP + TN)/ (P + N)
FPR <- 1 - (TN / N)
TPR <- TP / P

sprintf("Accuracy (ACC): %.3f", ACC)
## [1] "Accuracy (ACC): 0.859"
sprintf("False positive rate (FPR): %.3f", FPR)
## [1] "False positive rate (FPR): 0.220"
sprintf("True positive rate (TPR): %.3f", TPR)
## [1] "True positive rate (TPR): 0.884"

۶. نمودار صحت مدل (accuracy) را بر حسب مقادیر مختلف قطع برای داده تست رسم نمایید. کدام پارامتر قطع بالاترین صحت را در پیش بینی داراست؟ 

accuracy_info = AccuracyCutoffInfo(train = train , test = test, 
                                    predict = "prediction", actual = "MannerOfDeath" )
accuracy_info$plot

(accuracy_info$data)[which.max((accuracy_info$data)$test),] -> best_co_data
best_co_data
##    cutoff     train      test
## 1:   0.44 0.8618863 0.8596454
best_co <- best_co_data$cutoff
best_co
## [1] 0.44

۷. نمودار ROC را برای داده های قسمت قبل رسم نمایید. همچنین نقطه مربوط به بهترین پارامتر قطع را مشخص نمایید. 

cost_fp = 100;cost_fn = 100
roc_info = ROCInfo( data = test, predict = "prediction", 
                    actual = "MannerOfDeath", cost.fp = cost_fp, cost.fn = cost_fn )
roc_info$roc_plot

roc_info$cutoff
## [1] 0.4749434

۸. با قرار دادن کمیت nfolds = 5 و با استفاده از H20 مدل مساله را بسازید و نتیجه حاصل را ارزیابی کنید. 

library(h2o)
localH2O = h2o.init()
## 
## H2O is not running yet, starting it now...
## 
## Note:  In case of errors look at the following log files:
##     /var/folders/3k/99gqry2j4_n414pg9b4vvjtr0000gn/T//RtmpC6D9vJ/h2o_Mahbod_started_from_r.out
##     /var/folders/3k/99gqry2j4_n414pg9b4vvjtr0000gn/T//RtmpC6D9vJ/h2o_Mahbod_started_from_r.err
## 
## 
## Starting H2O JVM and connecting: .... Connection successful!
## 
## R is connected to the H2O cluster: 
##     H2O cluster uptime:         3 seconds 744 milliseconds 
##     H2O cluster version:        3.16.0.2 
##     H2O cluster version age:    4 months and 28 days !!! 
##     H2O cluster name:           H2O_started_from_R_Mahbod_lyl087 
##     H2O cluster total nodes:    1 
##     H2O cluster total memory:   1.78 GB 
##     H2O cluster total cores:    4 
##     H2O cluster allowed cores:  4 
##     H2O cluster healthy:        TRUE 
##     H2O Connection ip:          localhost 
##     H2O Connection port:        54321 
##     H2O Connection proxy:       NA 
##     H2O Internal Security:      FALSE 
##     H2O API Extensions:         XGBoost, Algos, AutoML, Core V3, Core V4 
##     R Version:                  R version 3.4.3 (2017-11-30)
hms = as.h2o(ms_3)
## 
  |                                                                       
  |                                                                 |   0%
  |                                                                       
  |=================================================================| 100%
chglm = h2o.glm(y = "MannerOfDeath", x= c("ResidentStatus", "Education2003Revision", "Age", "Sex",
                                          "PlaceOfDeathAndDecedentsStatus", "DayOfWeekOfDeath", "Race",
                                          "MaritalStatus", "InjuryAtWork", "Autopsy", 
                                          "NumberOfEntityAxisConditions",
                                          "NumberOfRecordAxisConditions"),
                training_frame = hms, family="binomial",nfolds = 5)
## 
  |                                                                       
  |                                                                 |   0%
  |                                                                       
  |==                                                               |   4%
  |                                                                       
  |========                                                         |  12%
  |                                                                       
  |==========================================================       |  89%
  |                                                                       
  |=================================================================| 100%
chglm
## Model Details:
## ==============
## 
## H2OBinomialModel: glm
## Model ID:  GLM_model_R_1524862526675_1 
## GLM Model: summary
##     family  link                                regularization
## 1 binomial logit Elastic Net (alpha = 0.5, lambda = 2.686E-4 )
##   number_of_predictors_total number_of_active_predictors
## 1                         46                          41
##   number_of_iterations training_frame
## 1                    6           ms_3
## 
## Coefficients: glm coefficients
##                     names coefficients standardized_coefficients
## 1               Intercept     0.336282                  1.313605
## 2 Education2003Revision.1    -1.058803                 -1.058803
## 3 Education2003Revision.2    -0.509703                 -0.509703
## 4 Education2003Revision.3    -0.176165                 -0.176165
## 5 Education2003Revision.4     0.228552                  0.228552
## 
## ---
##                           names coefficients standardized_coefficients
## 42               InjuryAtWork.Y    -1.211134                 -1.211134
## 43                    Autopsy.N     1.996195                  1.996195
## 44                    Autopsy.Y    -1.469199                 -1.469199
## 45                          Age     0.016704                  0.317790
## 46 NumberOfEntityAxisConditions     1.040597                  1.307041
## 47 NumberOfRecordAxisConditions    -1.137562                 -1.402541
## 
## H2OBinomialMetrics: glm
## ** Reported on training data. **
## 
## MSE:  0.09888414
## RMSE:  0.3144585
## LogLoss:  0.3162837
## Mean Per-Class Error:  0.2105248
## AUC:  0.9157035
## Gini:  0.8314069
## R^2:  0.4953363
## Residual Deviance:  30148.8
## AIC:  30232.8
## 
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
##            0     1    Error         Rate
## 0       8084  4665 0.365911  =4665/12749
## 1       1925 32987 0.055139  =1925/34912
## Totals 10009 37652 0.138268  =6590/47661
## 
## Maximum Metrics: Maximum metrics at their respective thresholds
##                         metric threshold    value idx
## 1                       max f1  0.456937 0.909184 255
## 2                       max f2  0.160896 0.946720 350
## 3                 max f0point5  0.712061 0.910345 165
## 4                 max accuracy  0.531408 0.863033 231
## 5                max precision  0.999353 1.000000   0
## 6                   max recall  0.018950 1.000000 398
## 7              max specificity  0.999353 1.000000   0
## 8             max absolute_mcc  0.584320 0.643870 212
## 9   max min_per_class_accuracy  0.718702 0.832614 162
## 10 max mean_per_class_accuracy  0.712061 0.833206 165
## 
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## 
## H2OBinomialMetrics: glm
## ** Reported on cross-validation data. **
## ** 5-fold cross-validation on training data (Metrics computed for combined holdout predictions) **
## 
## MSE:  0.09920926
## RMSE:  0.314975
## LogLoss:  0.3172353
## Mean Per-Class Error:  0.2121458
## AUC:  0.9151815
## Gini:  0.830363
## R^2:  0.493677
## Residual Deviance:  30239.5
## AIC:  30321.5
## 
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
##           0     1    Error         Rate
## 0      8035  4714 0.369754  =4714/12749
## 1      1904 33008 0.054537  =1904/34912
## Totals 9939 37722 0.138856  =6618/47661
## 
## Maximum Metrics: Maximum metrics at their respective thresholds
##                         metric threshold    value idx
## 1                       max f1  0.455357 0.908886 250
## 2                       max f2  0.165558 0.946630 342
## 3                 max f0point5  0.720328 0.910208 155
## 4                 max accuracy  0.541139 0.862592 220
## 5                max precision  0.998241 0.999052   2
## 6                   max recall  0.018870 1.000000 398
## 7              max specificity  0.999292 0.999922   0
## 8             max absolute_mcc  0.583279 0.642078 206
## 9   max min_per_class_accuracy  0.720328 0.831577 155
## 10 max mean_per_class_accuracy  0.720328 0.833037 155
## 
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## Cross-Validation Metrics Summary: 
##                 mean           sd cv_1_valid cv_2_valid cv_3_valid
## accuracy   0.8624647 0.0015400992  0.8663292  0.8607176 0.86031276
## auc        0.9151927 0.0030546724  0.9183656 0.91830033  0.9070786
## err       0.13753527 0.0015400992 0.13367084 0.13928239 0.13968724
## err_count     1311.2    25.761988     1241.0     1347.0     1322.0
## f0point5  0.89200115 0.0041372036  0.9032295  0.8872434 0.89008284
##           cv_4_valid cv_5_valid
## accuracy   0.8632241 0.86174005
## auc        0.9143679 0.91785115
## err       0.13677593 0.13825996
## err_count     1327.0     1319.0
## f0point5   0.8917758 0.88767433
## 
## ---
##                         mean           sd cv_1_valid cv_2_valid cv_3_valid
## precision         0.88095486  0.006438588 0.89851767  0.8739961 0.87810415
## r2                 0.4934981  0.007890478 0.49737248  0.5039628 0.47201863
## recall            0.93939555  0.006137439  0.9225816 0.94450766 0.94145435
## residual_deviance   6047.901   104.988815   5787.739   6076.453   6201.439
## rmse              0.31496376 0.0016716273 0.31251103 0.31387028 0.31944752
## specificity       0.65199006  0.020890968 0.70950633 0.63791144  0.6315577
##                   cv_4_valid cv_5_valid
## precision          0.8802001 0.87395626
## r2                0.49470016 0.49943635
## recall             0.9412924 0.94714165
## residual_deviance   6173.843    6000.03
## rmse               0.3148019  0.3141881
## specificity        0.6498653  0.6311094
kable(h2o.confusionMatrix(chglm))
0 1 Error Rate
0 8084 4665 0.3659111 =4665/12749
1 1925 32987 0.0551386 =1925/34912
Totals 10009 37652 0.1382682 =6590/47661

خطای مدل را می توانید در confusion-matrix مشاهده کنید چیزی حدود ۱۴ درصد است.

۹. آیا ما میتوانیم سرویسی به قضات ارایه کنیم تا با استفاده از اطلاعات مرگ بتوانند موارد مشکوک به قتل را از خودکشی تفکیک دهند؟

بستگی به منظور سوال از ما دارد! اگر منظور سوال این است که همین مدلی که اینجا درست کرده ایم به قضات کمک کند، این کار خوبی نیست زیرا خطای کار ما برای کار قضایی زیاد است و مناسب نیست. ولی اگر بتوان این خطا را کمتر کرد می توان از مدل به دست آمده استفاده کرد. همچنین در همین دنیای امروز در آمریکا بعضن از متدهای یادگیری ماشین و هوش مصنوعی در قضاوت استفاده می شود. و در آینده هم انتظار می رود که جای قضات را بگیرند.